;; Tests for compiling and running woof code.
;;

(module compile-and-run-test mzscheme
  (require (lib "list.ss" "srfi" "1"))
  (require (lib "34.ss" "srfi")) ;provides exception handling
  (require (lib "defmacro.ss"))
  (require (lib "kw.ss"))
  (require (planet "test.ss" ("schematics" "schemeunit.plt" 2 1)))
  (require (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2)))
  (require (planet "read.ss" ("ryanc" "scripting.plt" 1))) ;provides read-all
  (require "woof-machine.scm")
  (require "woof-kernel.scm")

  (define compile-and-run-tests
    (test-suite
     "Test the woof compiler and VM, end to end."

     (test-case
      "Test empty woof program."
      (let* ((code (compile-woof "")))
        (check-equal? code '((ARGS 0)(HALT)))
        ))

     (test-case
      "Test eval a literal"
      (let* ((state (eval-woof (string-append "1")))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? 1 (woof-object-prim-data tos))
        ))

     (test-case
      "Test eval an assignment, and then a reference."
      (let* ((state (eval-woof (string-append "a := 5."
                                              "a"
                                              )))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? 5 (woof-object-prim-data tos))
        ))

     (test-case
      "Test eval assignment of var to var, and then a reference."
      (let* ((state (eval-woof (string-append "a := 5."
                                              "b := a."
                                              "b"
                                              )))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? 5 (woof-object-prim-data tos))
        ))

     (test-case
      "Test eval of block."
      (let* ((state (eval-woof (string-append "[||  ]"
                                              )))
             (tos (first (machine-state-stack state))))
        (check-true (woof-block-object? tos))
        ))

     (test-case
      "Test eval of block with parameters."
      (let* ((state (eval-woof (string-append "[|a,b,c,d|  ]"
                                              )))
             (tos (first (machine-state-stack state))))
        (check-true (woof-block-object? tos))
        ))

     (test-case
      "Test call block with parameters."
      (let* ((state (eval-woof (string-append "a := 5."
                                              "b := 2."
                                              "@(call_block [|x| x], #(a))"
                                              )))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? 5 (woof-object-prim-data tos))
        ))

     (test-case
      "Test call block with no parameters."
      (let* ((state (eval-woof (string-append "a := 4."
                                              "b := 2."
                                              "@(call_block [|| a],#())"
                                              )))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? 4 (woof-object-prim-data tos))
        ))

     (test-case
      "Test block closure."
      (let* ((state (eval-woof (string-append "c := @(call_block [|| q := 1."
                                              "[|| q ]], #())."
                                              "@(call_block c, #())"
                                              )))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? 1 (woof-object-prim-data tos))
        ))

     (test-case
      "Test block closure generator."
      (let* ((state (eval-woof (string-append "gen := [|q| [|| q ]]."
                                              "f := @(call_block gen, #(4))."
                                              "@(call_block f, #())"
                                              )))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? 4 (woof-object-prim-data tos))
        ))

     (test-case
      "Test load_module primitive."
      (let* ((state (eval-woof (string-append "@(load_module 'prelude.woof')."
                                              "do: [|i| i] with: #(7)"
                                              )
			       #:globals (init-woof-globals! (new-woof-globals))
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? 7 (woof-object-prim-data tos))
        ))

     (test-case
      "Test new_instance primitive."
      (let* ((state (eval-woof (string-append "@(new_instance Object)")))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        ))

     (test-case
      "Test new: function."
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
                                              "a := new: Object"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? (class-by-name "Object" globals)(woof-object-class tos))
        ))

     (test-case
      "Test create_class primitive."
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(create_class 'Moose', Object, #(), #())")
		    #:globals globals))
             (tos (first (machine-state-stack state))))
        (check-true (woof-class-object? tos))
        ))

     (test-case
      "Test 'class:super:vars:classVars:' function."
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
					      "class: 'Moose' super: Object vars: #() classVars: #()."
                                              "a := new: Moose"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? (class-by-name "Moose" globals)(woof-object-class tos))
        ))

     (test-case
      "Test show_number primitive."
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(show_number 5)"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? (woof-object-prim-data tos) "5")
        ))

     (test-case
      "Test show_object primitive."
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(show_object [||])"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? (woof-object-prim-data tos) "<instance of Block>")
        ))

     (test-case
      "Test list_ref primitive."
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "list := #(1,2,3,4)."
					      "@(list_ref list, 2)"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? (woof-object-prim-data tos) 3)
        ))

     (test-case
      "Test list_ref primitive out of bounds."
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "list := #(1,2,3,4)."
					      "@(list_ref list, 20)"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? tos (woof-nil globals))
        ))
     
     (test-case
      "Test obj_eq primitive."
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "jack := 5."
					      "jill := jack."
					      "@(obj_eq jack,jill)"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? (woof-object-class tos) (class-by-name "True" globals))
        ))

     (test-case
      "Test nil singleton"
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(obj_eq nil,nil)"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? tos (woof-true globals))
        ))

     (test-case
      "Test equality operator."
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
					      "((false == false) == true)"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? tos (woof-true globals))
        ))

     (test-case
      "Test inequality operator."
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
					      "((false != true) == true)"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? tos (woof-true globals))
        ))

     (test-case
      "Addition primitive."
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
					      "1 + 2"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? 3 (woof-object-prim-data tos))
        ))

     (test-case
      "Test forEachOf:do:"
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
					      "sum := 0."
					      "forEachOf: #(1,1,1,1,1) do:"
					      "[|ea| sum := sum + 1]."
					      "sum"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? 5 (woof-object-prim-data tos))
        ))


     (test-case
      "Test set/get_instance_var primitive."
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
                                              "class: 'Moose' super: Object vars: #('feet') classVars: #()."
                                              "o := new: Moose."
					      "@(set_instance_var o, 'feet', 4)."
                                              "@(get_instance_var o, 'feet')"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? (woof-object-prim-data tos) 4)
        ))

     (test-case
      "Test get_instance_var, unset var is nil."
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
                                              "class: 'Moose' super: Object vars: #('feet') classVars: #()."
                                              "o := new: Moose."
                                              "@(get_instance_var o, 'feet')"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? tos (woof-nil globals))
        ))

     (test-case
      "Test string_concat primative"
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
                                              "@(string_concat 'cat', 'dog')"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? (woof-object-prim-data tos) "catdog")
        ))

     (test-case
      "Test list_concat primative"
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
                                              "@(list_concat #(1), #(2,3))"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? (length (woof-object-prim-data tos)) 3)
        ))

     (test-case
      "Test instance var accessors."
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
                                              "class: 'Moose' super: Object vars: #('feet') classVars: #()."
                                              "o := new: Moose."
                                              "feetOf: o is: 4."
                                              "feetOf: o"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? (woof-object-prim-data tos) 4)
        ))

     (test-case
      "Test Maybe on value."
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
                                              "m := new: Maybe on: 1."
                                              "if: m do: [|val| val] else: [||2]"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? (woof-object-prim-data tos) 1)
        ))

     (test-case
      "Test Maybe on nil."
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
                                              "m := new: Maybe on: nil."
                                              "if: m do: [|val| val] else: [||2]"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? (woof-object-prim-data tos) 2)
        ))

     (test-case
      "Test list_length primative"
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
                                              "@(list_length #(1,2,3))"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? (woof-object-prim-data tos) 3)
        ))


     (test-case
      "Test string_length primative"
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
                                              "@(string_length 'ape')"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? (woof-object-prim-data tos) 3)
        ))

     (test-case
      "Test assignment to global, then lookup of global."
      (let* ((state (eval-woof (string-append "$a := 5."
                                              "$a"
                                              )))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? 5 (woof-object-prim-data tos))
        ))

     (test-case
      "Test forEachWithIndexOf:do:"
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
					      "sum := 0."
					      "forEachWithIndexOf: "
					      "#(1,1,1,1,1) do:"
					      "[|ea,i| sum := sum + i]."
					      "sum"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? 10 (woof-object-prim-data tos))
        ))

     (test-case
      "Test selectFrom:where:"
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
					      "length: (selectFrom: "
					      "#(1,2,3,4,5) where:"
					      "[|ea| ea > 2])"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? 3 (woof-object-prim-data tos))
        ))

     (test-case
      "Test selectWithIndexFrom:where:"
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
					      "length: (selectWithIndexFrom: "
					      "#(1,2,3,4,5) where:"
					      "[|ea,i| i > 2])"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? 2 (woof-object-prim-data tos))
        ))


     (test-case
      "Test take:from:"
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
					      "length: (take: 2 from: #(1,2,3,4,5,6))"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? 2 (woof-object-prim-data tos))
        ))

     (test-case
      "Test drop:from:"
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
					      "length: (drop: 3 from: #(1,2,3,4,5,6))"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? 3 (woof-object-prim-data tos))
        ))

     (test-case
      "Test fold:over:with:"
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
					      "fold: [|ea,sum| ea + sum] over: #(1,2,3)"
					      "with: 0"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
        (check-equal? 6 (woof-object-prim-data tos))
        ))


     (test-case
      "Test withCC:"
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
					      "withCC: [|cc| cc]"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-continuation? tos))
        ))

     (test-case
      "Test withCC: and do:with: within static extent."
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
					      "cont := withCC: [|cc| do: cc with: 5. 10]"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
	(check-equal? 5 (woof-object-prim-data tos))
        ))

     (test-case
      "Test withCC: and do:with: with dynamic extent."
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
					      "cont := nil."
					      "i := withCC: [|cc| cont := cc. 2 ]."
					      "if: (i < 5)"
					      "do: [ do: cont with: 10 ]"
					      "else: [i]"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
	(check-equal? 10 (woof-object-prim-data tos))
        ))

     (test-case
      "Test withCC: and do:with:, returning multiple times."
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
					      "cont := nil."
					      "i := 0."
					      "i := withCC: [|cc| cont := cc. i]."
					      "if: (i < 20)"
					      "do: [ do: cont with: (i + 1) ]"
					      "else: [i]"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
	(check-equal? 20 (woof-object-prim-data tos))
        ))

     (test-case
      "Test try:catch: without an error."
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
					      "try: [ 1 + 2] catch: [|e| ]"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
	(check-equal? 3 (woof-object-prim-data tos))
        ))

     (test-case
      "Test try:catch: WITH an error."
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
					      "try: [ 1 + 2. throw: (new: Error)]"
					      "catch: [|e| 5]"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
	(check-equal? 5 (woof-object-prim-data tos))
        ))
     
     (test-case
      "Test nested try:catch"
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
					      "a := 0."
					      "try: [ a := a + 1. try: [ throw: (new: Error)]"
					      "catch: [ a := a + 1. throw: (new: Error)]]"
					      "catch: [|e| a]"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
	(check-equal? 2 (woof-object-prim-data tos))
        ))

     (test-case
      "Test load block from file."
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_block_from_file 'prelude.woof')")
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-block-object? tos))
        ))

     (test-case
      "Test error"
      (let* ((globals (init-woof-globals! (new-woof-globals)))
	     (state (eval-woof (string-append "@(load_module 'prelude.woof')."
					      "e := new: Error withMsg: 'hello'."
					      "messageOf: e"
                                              )
			       #:globals globals
			       ))
             (tos (first (machine-state-stack state))))
        (check-true (woof-object? tos))
	(check-equal? "hello" (woof-object-prim-data tos))
        ))
     
     ))

  (define run-compile-and-run-tests
    (lambda ()
      (test/text-ui compile-and-run-tests)))

  (provide (all-defined))

  )
